home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
Prefs
/
Prefs.p
Wrap
Text File
|
1992-11-25
|
5KB
|
166 lines
{ Source code for "And Then There Were Preferences" in the Fall 1990 issue }
{ of THINKin' CaP }
{ © 1991 Eric Slosser. All rights reserved. }
{ Modified: Jan 92, D.B. Lamkins — editorial changes, System 7 support, }
{ improved error handling. }
{ Modified: Nov 92, D.B. Lamkins — set type and creator of new file, get }
{ rid of hard-coded STR# ID.}
unit Prefs;
interface
{ Pass back the reference number to the preferences file. }
{ This file is a resource file located in a subfolder of the }
{ System folder. The names of the subfolder and the }
{ prefs file are specified in a STR# resource (but for }
{ System 7 and later, the name of the preferences folder }
{ is determined by the system, and may vary according }
{ to localization of the system software). }
{ The STR# resource also specifies type and creator for }
{ a new file. }
{}
{ This routine will create the prefs file and subfolder if }
{ necessary. }
{}
{ The file reference number is -1 if there is an error. }
function GetPrefsFileRefNum (prefsInfoID: Integer; var pfRefNum: integer): OSErr;
implementation
uses
Folders;
const
kPrefsFolderNameIndex = 1; { prefsInfoID STR# indices }
kPrefsFileNameIndex = 2;
kPrefsTypeCreatorIndex = 3;
function myHSetVol (name: StringPtr; vRefNum: integer; WDDirID: longint): OSErr;
var
pb: WDPBRec;
begin
pb.ioNamePtr := name;
pb.ioVRefNum := vRefNum;
pb.ioWDDirID := WDDirID;
myHSetVol := PBHSetVol(@pb, false);
end;
function GetPrefsFileRefNum (prefsInfoID: Integer; var pfRefNum: integer): OSErr;
label
99;
var
err: OSErr;
fileNotFound: Boolean;
world: SysEnvRec;
prefsFolderVRefNum, saved: integer;
prefsFolderDirID: longint;
tempString: Str255;
prefsFolderName, prefsFileName: Str31;
cpb: CInfoPBRec;
fndrInfo: FInfo;
begin
pfRefNum := -1; { Setup for a bad return. }
err := GetVol(nil, saved); { Remember our starting volume ref. }
{ See what system we are running. }
err := SysEnvirons(curSysEnvVers, world);
if err <> noErr then
goto 99;
if world.systemVersion < $0420 then
goto 99
else if world.systemVersion >= $0700 then
begin
err := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, prefsFolderVRefNum, prefsFolderDirID);
if err <> noErr then
goto 99;
end
else
begin
{ Get prefs folder name from a STR# resource. }
GetIndString(tempString, prefsInfoID, kPrefsFolderNameIndex);
prefsFolderName := tempString;
if ResError <> noErr then
goto 99;
{ Start by getting the dirID of the system folder. }
cpb.ioNamePtr := nil;
cpb.ioVRefNum := world.sysVRefNum;
cpb.ioDirID := 0;
cpb.ioFDirIndex := -1;
err := PBGetCatInfo(@cpb, false);
if err <> noErr then
goto 99;
{ Now ioDir is set to the id of the system folder, so look for prefs folder. }
cpb.ioNamePtr := @prefsFolderName;
cpb.ioFDirIndex := 0;
err := PBGetCatInfo(@cpb, false);
{ If prefs folder doesn 't exist, create it. }
if err = fnfErr then
begin
err := PBDirCreate(@cpb, false);
if err <> noErr then
goto 99;
end
else if err <> noErr then
goto 99;
prefsFolderVRefNum := cpb.ioVRefNum;
prefsFolderDirID := cpb.ioDirID;
end;
{ Get prefs file name from STR# resource. }
GetIndString(tempString, prefsInfoID, kPrefsFileNameIndex);
prefsFileName := tempString;
if ResError <> noErr then
goto 99;
{ Look for the prefs file in the prefs folder. }
cpb.ioNamePtr := @prefsFileName;
cpb.ioVRefNum := prefsFolderVRefNum;
cpb.ioDirID := prefsFolderDirID;
cpb.ioFDirIndex := 0;
cpb.ioFVersNum := 0;
err := PBGetCatInfo(@cpb, false);
fileNotFound := err = fnfErr;
{ Temporarily change defaults to the prefs folder. }
err := myHSetVol(nil, world.sysVRefNum, prefsFolderDirID);
{ If prefs file doesn't exist, create it. }
if fileNotFound then
begin
CreateResFile(prefsFileName);
err := ResError;
if err = noErr then
begin
err := GetFInfo(prefsFileName, 0, fndrInfo);
GetIndString(tempString, prefsInfoID, kPrefsTypeCreatorIndex);
BlockMove(@tempString[1], @fndrInfo.fdType, 2 * SIZEOF(OSType));
if err = noErr then
err := SetFInfo(prefsFileName, 0, fndrInfo);
end;
end;
{ Bail out if CreateResFile failed or error wasn't fnfErr. }
if err <> noErr then
goto 99;
{ Open the prefs file. }
pfRefNum := OpenResFile(prefsFileName);
99:
{ Change default back to saved. }
err := SetVol(nil, saved);
GetPrefsFileRefNum := err;
end; { GetPrefsFileRefNum }
end.